\ syscalls.utf .. calling DLLs from Jax4th
\ Copyright (c)1994 Jack J. Woehr
\ P.O. Box 51, Golden, Colorado 80402-0051
\ jax@well.sf.ca.us 72203.1320@compuserve.com
\ SYSOP RCFB (303) 278-0364 3/12/24/96/14.4 24 hours
\ All Rights Reserved
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\ This is free software and can be modified and redistributed under
\ certain conditions described in the file COPYING.TXT. The
\ Disclaimer of Warranty and License for this free software are also
\ contained in the file COPYING.TXT.
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

\ 
\ $Revision: 1.2 $
\ 

MARKER syscalls.utf

\ ~~~~~~~~~~~~~~~~~~~~
\ Conditional INCLUDED
\ ~~~~~~~~~~~~~~~~~~~~

: PROVIDES ( c-addr u "ccc< >" --)
    BL WORD FIND NIP 0=
    IF INCLUDED ELSE 2DROP THEN ;

S" UTILS\UTILS.UTF" PROVIDES USEFUL

CR .( Loading System Call Examples) CR

\ ~~~~~~~~~~~~~~~~~~~~~~~~~~
\ Libraries and System Calls
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~

DECIMAL USEFUL
INTERNALS-WORDLIST ALSO-WID DEFINITIONS

\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\ Adds a system call compilation regimen. The user may open
\ all referenced libraries and resolve all referenced system
\ calls at once. Greate for boot words in saved images.
\ Dependecies on NT operating system.
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

\ Backlink pointer for list of libs to open.
VARIABLE LIBRARIES-LINK
: LLINIT ( --) 0 LIBRARIES-LINK ! ; LLINIT

\ Backlink pointer for list of syscalls to resolve.
VARIABLE SYSCALLS-LINK
: SLINIT ( --) 0 SYSCALLS-LINK ! ; SLINIT

\ Linked list handling for these def-to-def pointers.
: BACKLINK  ( var n  --)
    DP @ SWAP
    CELLS - MAKETOKEN
    OVER @ ,
    SWAP !
;
\ Link library in to list of libraries
\   n is number of cells to back up to find execution addr.
\   var is the address of the end-of-list pointer.
\   Compile backlink, store new link.

USEFUL INTERNALS-WORDLIST ALSO-WID

\ Declare a dynamic link library.
\ This works with any NT DLL, not just NT's own
: LIBRARY ( c-addr u --)
    CREATE 0 , LIBRARIES-LINK 2 BACKLINK
    TUCK HERE SWAP CMOVE
    CHARS ALLOT 0 C, ALIGN
;
\ Data structure of library: /lib-ptr/library-link/string...
\ lib-ptr is the storage slot for the library handle
\ library-link is the backlink to the previous declared lib

\ Open a DLL and store its handle
: OPEN-LIB ( a-addr --)
    DUP 2 CELLS + DATATOABS \ find string in body of Library construct
    0 0 ROT LoadLibraryEx   \ call system
    ?DUP 0=                 \ failure?
    ABORT" Couldn't open library."
    SWAP !                  \ done, save handle
;

    
\ We keep libraries in a linked list.
\ Open all declared libraries
: OPEN-ALL ( --)
    LIBRARIES-LINK @    \ Variable holding pointer to last lib
    BEGIN
        ?DUP            \ is it a pointer or null?
    WHILE               \ while it's a pointer
        EXECUTE         \ (actually xt) execute it
        DUP OPEN-LIB
     CELL+              \ then convert xt to data address
     @                  \ and find address of backptr
    REPEAT              \ loop until libs all opened
;

\ And close all, good practice!
\ Walk thru linked list of libraries and close
: CLOSE-ALL ( --)
    LIBRARIES-LINK @
    BEGIN ?DUP
    WHILE EXECUTE DUP FreeLibrary DROP
     CELL+ @
    REPEAT
;

\ Declaring a DLL call, also kept in a linked list.
\ This works with any NT DLL, not just NT's own.
: SYSTEMCALL ( c-addr u a-addr --)
    CREATE 0 , , SYSCALLS-LINK 2 BACKLINK
    DUP C,
    TUCK HERE SWAP CMOVE
    1+ CHARS ALLOT ALIGN
    DOES> ( i*x -- j*x)
    @ SYSCALL
;
\ The data structure of a system call:
\ /calladdr/lib/backptr string ...
\ calladdr stores the resolved addr after this call resolved
\ lib is the address returned by a LIBRARY construct
\ string is the case-sensitive name of call (e.g., Beep)
\ backptr is analogous to the library back pointer: all calls
\ are linked back so that all can be resolved at once.

SYSTEM-WORDLIST SET-CURRENT

\ Given the data address of the data structure of a system call,
\ resolve that call. Presumes library open already.
: (RESOLVE-CALL) ( a-addr --)
     DUP CELL+ @ @          \ Library pointer
     OVER 3 CELLS +         \ Call name string)
     COUNT ASCIIZ DATATOABS \ Address of null-terminated ASCII)
     SWAP GetProcAddress
     ?DUP 0= ABORT" Couldn't resolve call."
     SWAP !
;

USEFUL

\ Wrapper of above.
: RESOLVE-CALL ( "ccc" --)
    ' >BODY
    STATE @
    IF   POSTPONE LITERAL POSTPONE (RESOLVE-CALL)
    ELSE (RESOLVE-CALL)
    THEN
; IMMEDIATE

INTERNALS-WORDLIST ALSO-WID

\ Resolve all currently defined calls. Presumes appropriate
\ libs are open. Harmless to do twice or three times.
: RESOLVE-ALL ( --)
    SYSCALLS-LINK @
    BEGIN
        ?DUP
    WHILE
        >BODY DUP (RESOLVE-CALL)
        2 CELLS + @
    REPEAT
;

USEFUL

\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\ Some Libraries and Calls Declared
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

\ Let's declare a few DLLs, to be resolved.
S" KERNEL32.DLL" LIBRARY KERNEL32
S" GDI32.DLL" LIBRARY GDI32
S" USER32.DLL" LIBRARY USER32

\ Let's declare a few calls, to be resolved
S" Beep" KERNEL32 SYSTEMCALL BEEP
S" SetCurrentDirectoryA"  KERNEL32 SYSTEMCALL (CHDIR)
S" GetCurrentDirectoryW"  KERNEL32 SYSTEMCALL (GTDIR)

\ Here's a high-level word to illustrate system calls.
: CHDIR ( "<>chars<>" --)
    BL WORD COUNT DUP 0<>           \ did user provide a path
    IF                              \ if so, change path
        ASCIIZ DATATOABS (CHDIR)
    THEN
    2DROP                           \ we don't care about returns here
    CR PAD DATATOABS 128 (GTDIR)    \ get the current parth
    2DROP                           \ we don't care about returns here
    PAD 128 0TYPE                   \ show the current path
;

\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\ Demo: Mary Had A Little Lamb
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~

SYSTEM-WORDLIST NONSTANDARD-WORDLIST FORTH-WORDLIST
3 SET-ORDER DEFINITIONS

DECIMAL

: MHALL ( --)
    CR ." Now I'm going to sing! ..."
    CR ." Ma-"   500 657 BEEP ." ry "  500 586 BEEP
       ." had "  500 522 BEEP ." a "   500 586 BEEP
       ." lit-"  500 657 BEEP ." tle " 500 657 BEEP
       ." lamb." 500 657 BEEP
    7 0 DO 2DROP LOOP
    CR
;

OPEN-ALL RESOLVE-ALL
MHALL
CLOSE-ALL

USEFUL DECIMAL

\ ~~~~~~~~~~~~~~~~~
\ End of syscalls.h
\ ~~~~~~~~~~~~~~~~~